home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_vw.lha / st80_vw / ClassBrowsers.st next >
Text File  |  1993-07-24  |  60KB  |  1,709 lines

  1. "       NAME            ClassBrowser
  2.         AUTHOR          Carl@ParcPlace.com (Carl Gable Watts)
  3.         FUNCTION    New class browsers for Smalltalk.  Features of FullBrowser without the clutter.
  4.         ST-VERSIONS     Objectworks 4.1, Visualworks 1.0
  5.         PREREQUISITES    None
  6.         CONFLICTS        None
  7.         DISTRIBUTION    world
  8.         VERSION         4.1.1
  9.         DATE    June 28, 1993
  10.     SUMMARY ClassBrowser & SystemOrganizerBrowser
  11.  
  12.     Instances of SystemOrganizerBrowser browse a SystemOrganizer like ''Smalltalk organization''.  This class and its collaborator (ClassBrowser) provide a replacement for the standard Browser for browsing classes in Smalltalk.
  13.     Instances of ClassBrowser support browsing and editing of individual classes providing (in concert with its collaborator SystemOrganizerBrowser) significantly more abilitity than the standard Browser/BrowserView.
  14.     To open a SystemOrganizerBrowser of this evaluate (SystemOrganizerBrowser open).
  15.  
  16.     Carl Gable Watts
  17. "!
  18.  
  19.  
  20.  
  21. Browser subclass: #SystemOrganizerBrowser
  22.     instanceVariableNames: 'takenClass '
  23.     classVariableNames: ''
  24.     poolDictionaries: ''
  25.     category: 'Tools-Programming'!
  26.  
  27. SystemOrganizerBrowser comment:
  28. 'Instances of SystemOrganizerBrowser browse a SystemOrganizer like ''Smalltalk organization''.  This class and its collaborator (ClassBrowser) provide a replacement for the standard Browser for browsing classes in Smalltalk.
  29.  
  30. This class was written and is owned by Carl Watts (Email:  Carl@ParcPlace.com).  You are free to use this class and modify it if you wish but you cannot redistribute this class or any part of it without including this paragraph in the class comment.  Please send any improvements you implement to me (at my email address) so I can consider putting them in my next version.
  31.  
  32. This class and its collaborating class ClassBrowser both have install messages that you can use to modify the Browser class so it will use these new browsers in preference to the standard ones in Browser.  There are also uninstall messages.
  33.  
  34. The menus used by this class are more context sensitive than many other Smalltalk applications.  The menues are constructed to be sensitive to whatever you have selected.  The menu items are very different if you have something selected and if you don''t (as context sensitively appropriate).  Methods for all menu selections are in the ''category menu methods'' and ''class menu methods'' protocols.  The comment for each will explain its use.
  35.  
  36. To open an instance of this evaluate (SystemOrganizerBrowser open).  
  37.  
  38.  
  39. Instance Variables:
  40.     takenClass     <Symbol> The name of the last ''taken'' class by the ''take it'' menu item.
  41. '!
  42.  
  43.  
  44. !SystemOrganizerBrowser methodsFor: 'category list'!
  45.  
  46. categoryList
  47.     "Answer the sequenceable collection containing the class categories that 
  48.     the receiver accesses."
  49.  
  50.     ^organization categories asSortedCollection!
  51.  
  52. categoryMenu
  53.  
  54.     "Answer an menu of operations on class categories to be displayed when the operate menu button is pressed."
  55.  
  56.     | selectors |
  57.  
  58.     (category isNil) ifTrue: [
  59.         ^self menuForSelectorPredicates: #(findClass updateCategories addCategory)].
  60.     selectors := OrderedCollection new.
  61.     takenClass notNil ifTrue: [
  62.         selectors add: #andMoveClassInHere].
  63.     selectors addAll: #(findClass makeNewClass fileoutCategory printoutCategory renameCategory removeCategory).
  64.     ^self menuForSelectorPredicates: selectors objectOfVerbs: #category!
  65.  
  66. newCategorySelection: categorySelection
  67.  
  68.     "Set the currently selected category to be categorySelection."
  69.  
  70.     categorySelection = category ifTrue: [^self].
  71.     category := categorySelection.
  72.     self changed: #category! !
  73.  
  74. !SystemOrganizerBrowser methodsFor: 'class list'!
  75.  
  76. classMenu
  77.  
  78. "Answer an menu of operations on classes that is to be displayed when the operate menu button is pressed."
  79.  
  80.     | selectors |
  81.  
  82.     (className isNil) ifTrue: [
  83.         ^self menuForSelectorPredicates: #(makeNewClass)].
  84.     selectors := OrderedCollection new.
  85.     selectors add: #browseClass.
  86.     self canMakeItASubclass
  87.         ifTrue: [selectors addAll: #(takeClass andMakeItASubclass)]
  88.         ifFalse: [selectors add: #takeClass].
  89.     selectors addAll: #(
  90.         findSuperclass
  91.         findSubclass
  92.         browseClassReferences
  93.         showCollaborators
  94.         showMinions
  95.         showLeiges
  96.         fileOutClass
  97.         printOutClass
  98.         makeNewSubclass
  99.         renameClass
  100.         removeClass).
  101.     ^self menuForSelectorPredicates: selectors objectOfVerbs: #class! !
  102.  
  103. !SystemOrganizerBrowser methodsFor: 'class menu methods'!
  104.  
  105. andMakeItASubclass
  106.  
  107.     "Make the last 'taken' class (see takeClass) a subclass of the currently selected class."
  108.  
  109.     | theTakenClass |
  110.     theTakenClass := Smalltalk at: takenClass.
  111.  
  112.     self nonMetaClass
  113.         subclass: theTakenClass name
  114.         instanceVariableNames: theTakenClass instanceVariablesString
  115.         classVariableNames: theTakenClass classVariablesString
  116.         poolDictionaries: theTakenClass sharedPoolsString
  117.         category: theTakenClass category asString.
  118.     SourceFileManager default logChange: theTakenClass definition.
  119.  
  120.     takenClass := nil!
  121.  
  122. browseClass
  123.  
  124.     "Browse the class that is currently selected class."
  125.     "Use the ClassBrowser if it exists, otherwise use the Browser."
  126.  
  127.     (ClassBrowser respondsTo: #newOnClass:)
  128.         ifTrue: [ClassBrowser newOnClass: self nonMetaClass]
  129.         ifFalse: [Browser newOnClass: self nonMetaClass]!
  130.  
  131. fileoutClass
  132.  
  133.     "Fileout the selected class to a file.  Prompt for the name of the file."
  134.     "Use the inherited fileOutClass."
  135.  
  136.     super fileOutClass!
  137.  
  138. findSubclass
  139.  
  140.     "Present a menu of the subClasses of the selected class and if one is selected show it."
  141.  
  142.     | menuLabels choice chosenClass |
  143.  
  144.     menuLabels := OrderedCollection new.
  145.     self addSubclassNameListFor: self nonMetaClass to: menuLabels prefix: ''.
  146.     (menuLabels isEmpty) ifFalse: [
  147.         choice := (PopUpMenu labelList: (Array with: menuLabels)) startUp.
  148.         (choice = 0) ifFalse: [
  149.             chosenClass := Smalltalk at: ((menuLabels at: choice) copyWithout: Character space) asSymbol.
  150.             self newCategorySelection: chosenClass category.    
  151.             self newClassList: chosenClass name]]!
  152.  
  153. findSuperclass
  154.  
  155.     "Present a menu of the superClasses of the selected class and if one is selected show it."
  156.  
  157.     | superclasses menuLabels choice |
  158.  
  159.     superclasses := self nonMetaClass allSuperclasses reverse.
  160.     (superclasses isEmpty) ifFalse: [
  161.         menuLabels := Array with: (superclasses collect: [:class | class name]).
  162.         choice := (PopUpMenu labelList: menuLabels) startUp.
  163.         (choice = 0) ifFalse: [
  164.             self newCategorySelection: (superclasses at: choice) category.    
  165.             self newClassList: (superclasses at: choice) name]]!
  166.  
  167. makeNewClass
  168.  
  169.     "Prompt for the name of a new Class in the currently selected class category.  The new Class will be a subclass of Object."
  170.  
  171.     | aString newClassName |
  172.  
  173.     self changeRequest ifFalse: [^self].
  174.     aString := self prompt: 'Enter name of new class' initially: ''.
  175.     aString isEmpty ifTrue: [^self].
  176.     newClassName := (Scanner new) scanFieldNames: aString.
  177.     newClassName isEmpty ifTrue: [^self].
  178.     self makeClassNamed: newClassName first asSymbol superClass: Object!
  179.  
  180. makeNewSubclass
  181.  
  182.     "Prompt for the name of a new subclass for the currently selected class.  If the name entered is not already the name of a class, then make it a class in the current category."
  183.  
  184.     | aString newClassName |
  185.  
  186.     self changeRequest ifFalse: [^self].
  187.     aString := self prompt: 'Enter name of new subclass' initially: ''.
  188.     aString isEmpty ifTrue: [^self].
  189.     newClassName := (Scanner new) scanFieldNames: aString.
  190.     newClassName isEmpty ifTrue: [^self].
  191.     self makeClassNamed: newClassName first asSymbol superClass: self nonMetaClass!
  192.  
  193. printoutClass
  194.  
  195.     "Printout the selected class with all of its methods to a printer."
  196.     "Use the inherited printOutClass."
  197.  
  198.     super printOutClass!
  199.  
  200. showCollaborators
  201.  
  202.     "Show the collaborating classes of the selected class."
  203.  
  204.     DialogView warn: 'Show collaborators has not been implemented yet.'!
  205.  
  206. showLeiges
  207.  
  208. "Show the leige (sp?) classes of the selected class.  These are classes which use the selected class but which the selected class don't use."
  209.  
  210.     DialogView warn: 'Show leiges has not been implemented yet.'!
  211.  
  212. showMinions
  213.  
  214.     "Show the minion classes of the selected class.  These are classes which the selected class uses but which don't use it."
  215.  
  216.     DialogView warn: 'Show minions has not been implemented yet.'!
  217.  
  218. takeClass
  219.  
  220.     "Take the currently selected class class and remember it.  This allows it to be moved into a different class category (see andMoveClassInHere) or moved to a different superclass (see andMakeItASubclass).  To move it to a different class category, select the category you want to move it to and perform: andMoveClassInHere from the menu for the category list.  To move it to be a subclass of a different superclass, select the new superclass and perform: andMakeItASubclass from the menu for the class list."
  221.  
  222.     takenClass := self className! !
  223.  
  224. !SystemOrganizerBrowser methodsFor: 'category menu methods'!
  225.  
  226. andMoveClassInHere
  227.  
  228.     "Move the last 'taken' class (see takeClass) into the currently selected class category."
  229.  
  230.     | theClass |
  231.     theClass := Smalltalk at: takenClass.
  232.     takenClass := nil.
  233.     theClass category: self category asString.
  234.     ChangeSet current changeClass: theClass.
  235.     SourceFileManager default logChange: theClass name, ' category: ', self category asString printString.
  236.     self newClassList: theClass name!
  237.  
  238. fileoutCategory
  239.  
  240.     "File out all the classes in the current class category."
  241.     "Use the inherited fileOutCategory."
  242.  
  243.     super fileOutCategory!
  244.  
  245. printoutCategory
  246.  
  247.     "File out all the classes in the current class category."
  248.     "Use the inherited printOutCategory."
  249.  
  250.     super printOutCategory!
  251.  
  252. updateCategories
  253.  
  254.     "Update the categories list."
  255.  
  256.     self changed: #category! !
  257.  
  258. !SystemOrganizerBrowser methodsFor: 'view creation'!
  259.  
  260. open
  261.  
  262. "Open a view on the receiver."
  263.  
  264.     | topView label window |
  265.  
  266.     Smalltalk organization == organization
  267.         ifTrue: [label := 'Smalltalk organization']
  268.         ifFalse: [label := self printString].
  269.     window := ScheduledWindow
  270.         model: self
  271.         label: label
  272.         minimumSize: 300@200.
  273.  
  274.     topView := CompositePart new.
  275.     window component: topView.
  276.  
  277.     topView add: (LookPreferences edgeDecorator on:
  278.         (SelectionInListView on: self
  279.             aspect: #category change: #category: list: #categoryList
  280.             menu: #categoryMenu initialSelection: #category))
  281.         in: (LayoutFrame new rightFraction: 0.5; bottomFraction: 1).
  282.  
  283.     topView add: (LookPreferences edgeDecorator on:
  284.         (SelectionInListView on: self
  285.             aspect: #className change: #className: list: #classList
  286.             menu: #classMenu initialSelection: #className))
  287.         in: (LayoutFrame new leftFraction: 0.5; rightFraction: 1; bottomFraction: 1).
  288.  
  289.     window open! !
  290.  
  291. !SystemOrganizerBrowser methodsFor: 'menu construction'!
  292.  
  293. menuForSelectorPredicates: selectorPredicates
  294.  
  295.     "Answer a menu appropriate for the given collection of selectorPredicates (selectors which are predicate phrases)"
  296.     "This behavior should exist in PopUpMenu.  And PopUpMenu should be generalized since a menu is a more general concept than a PopUpMenu."
  297.  
  298.     "This functionality is currently implemented by class ClassBrowser."
  299.     ^ClassBrowser menuForSelectorPredicates: selectorPredicates!
  300.  
  301. menuForSelectorPredicates: selectorPredicates objectOfVerbs: objectOfVerbs
  302.  
  303.     "Answer a menu appropriate for the given collection of message selectors and with objectOfVerbs (a String) implied in the menu labels. If objectOfVerbs is nil then the labels will be generated without a objectOfVerbs."
  304.     "This behavior should exist in PopUpMenu.  And PopUpMenu should be generalized since a menu is a more general concept than a PopUpMenu."
  305.  
  306.     "This functionality is currently being implemented by class ClassBrowser."
  307.     ^ClassBrowser menuForSelectorPredicates: selectorPredicates objectOfVerbs: objectOfVerbs! !
  308.  
  309. !SystemOrganizerBrowser methodsFor: 'class list support'!
  310.  
  311. addSubclassNameListFor: aClass to: aCollection prefix: prefix
  312.  
  313. "Append to aCollection strings of the names of the subclasses of aClass all prefixed by prefix string (a string of spaces)."
  314.  
  315.     | subclasses |
  316.  
  317.     subclasses := aClass subclasses asSortedCollection: [:e1 :e2 | e1 name < e2 name].
  318.     subclasses do: [:subclass |
  319.         subclass isMeta ifFalse: [
  320.             aCollection add: (prefix, subclass name).
  321.             self addSubclassNameListFor: subclass to: aCollection prefix: prefix, '  ']]!
  322.  
  323. canMakeItASubclass
  324.  
  325. "Answer if the taken class (if any) can be made a subclass of the currently selected class."
  326.  
  327.     | theTakenClass |
  328.     takenClass isNil ifTrue: [^false].
  329.     (takenClass = self className) ifTrue: [^false].
  330.     theTakenClass := Smalltalk at: takenClass ifAbsent: [^false].
  331.     (theTakenClass superclass = self selectedClass) ifTrue: [^false].
  332.     (self selectedClass inheritsFrom: theTakenClass) ifTrue: [^false].
  333.     ^true!
  334.  
  335. findClassFor: anObject
  336.  
  337.     "Find the class category and class for anObject."
  338.  
  339.     | theClass |
  340.     anObject isBehavior
  341.         ifTrue: [theClass := anObject]
  342.         ifFalse: [theClass := anObject class].
  343.     theClass isMeta ifTrue: [theClass := theClass soleInstance].
  344.     self newCategorySelection: theClass category.
  345.     self newClassList: theClass name!
  346.  
  347. makeClassNamed: aClassname superClass: aClass
  348.  
  349.     "Make a new Class named aClassname with aClass as its superclass.  Put the new class in the currently selected class category.  If such a class already exists, then just show the existing one."
  350.  
  351.     | newClassName |
  352.     newClassName := aClassname asString copy.
  353.     newClassName at: 1 put: newClassName first asUppercase.
  354.     newClassName := newClassName asSymbol.
  355.     (Smalltalk includesKey: newClassName) ifTrue: [
  356.         Transcript cr; show: newClassName , ' already exists'.
  357.         ^self findClassFor: (Smalltalk at: newClassName)].
  358.     aClass subclass: newClassName instanceVariableNames: ''
  359.         classVariableNames: '' poolDictionaries: '' category: self category asString.
  360.     SourceFileManager default logChange: (Smalltalk at: newClassName) definition.
  361.     self newClassList: newClassName.
  362.     self takeClass! !
  363. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  364.  
  365. SystemOrganizerBrowser class
  366.     instanceVariableNames: ''!
  367.  
  368.  
  369. !SystemOrganizerBrowser class methodsFor: 'view creation'!
  370.  
  371. open
  372.  
  373. "Open a new instance of the receiver on Smalltalk organization."
  374. "SystemOrganizerBrowser open"
  375.  
  376.     self openOn: Smalltalk organization!
  377.  
  378. openOn: aSystemOrganizer
  379.  
  380. "Open an instance of the receiver on a SystemOrganizer."
  381.  
  382.     (self new on: aSystemOrganizer) open! !
  383.  
  384. !SystemOrganizerBrowser class methodsFor: 'private'!
  385.  
  386. doInstall
  387.  
  388. "Install a method in Browser to have SystemOrganizerBrowser replace the normal Browser."
  389.  
  390.     Browser class
  391.         compile: 'open
  392.  
  393. "Create and schedule a view that is a Browser for the Smalltalk organization."
  394. "Be paranoid about SystemOrganizer existing."
  395.  
  396.     (SystemOrganizerBrowser respondsTo: #open) & (self = Browser)
  397.         ifTrue: [SystemOrganizerBrowser open]
  398.         ifFalse: [self openOn: Smalltalk organization]'
  399.         classified: 'instance creation'!
  400.  
  401. doUninstall
  402.  
  403. "Uninstall the method in Browser to have SystemOrganizerBrowser replace the normal Browser."
  404.  
  405.     Browser class
  406.         compile: 'open
  407.     "Browser open"
  408.     self openOn: Smalltalk organization'
  409.         classified: 'view creation'! !
  410.  
  411. !SystemOrganizerBrowser class methodsFor: 'class initialization'!
  412.  
  413. install
  414.  
  415. "Install methods in Browser to have ClassBrowser and SystemOrganizerBrowser replace the normal Browsers."
  416.  
  417.     ClassBrowser doInstall.
  418.     self doInstall!
  419.  
  420. unInstall
  421.  
  422. "Uninstall the methods in Browser to have ClassBrowser and SystemOrganizerBrowser replace the normal Browsers."
  423.  
  424.     ClassBrowser doUninstall.
  425.     self doUninstall! !
  426.  
  427.  
  428. Browser subclass: #ClassBrowser
  429.     instanceVariableNames: 'variable upToObject '
  430.     classVariableNames: 'TakenMethod '
  431.     poolDictionaries: ''
  432.     category: 'Tools-Programming'!
  433. ClassBrowser comment:
  434. 'Instances of ClassBrowser support browsing and editing of individual classes providing (in concert with its collaborator SystemOrganizerBrowser) significantly more abilitity than the standard Browser/BrowserView.
  435.  
  436. This class was written and is owned by Carl Watts (Email:  Carl@ParcPlace.com).  You are free to use this class and modify it if you wish but you cannot redistribute this class or any part of it without including this paragraph in the class comment.  Please send any improvements you implement to me (at my email address) so I can consider putting them in my next version.
  437.  
  438. This class and its collaborating class ClassBrowser both have install messages that you can use to modify the Browser class so it will use these new browsers in preference to the standard ones in Browser.  There are also uninstall messages.
  439.  
  440. The most important feature of this browser is that it always shows you inherited attributes as well as attributes locally defined in the class.  Attributes (like representation variables and methods) that are locally defined are shown highlighted in bold.
  441.  
  442. The metaphor for moving something (like a method) to a different place (like a different protocol) is to select the item you want to move, select ''take it...'' from the menu, select the place you want to move it to (like the protocol, and then select ''and move it here...'' from the menu of destination.
  443.  
  444. To try out using a class browser, open a SystemOrganizerBrowser (SystemOrganizerBrowser open), and then browse a class.  You can install these browsers so that they will be used in preference to Browser by evaluating ''ClassBrowser install''.  They can later be uninstalled by evaluating ''ClassBrowser uninstall''.
  445.  
  446. The PopUpMenus used by this class are more context sensitive than many other Smalltalk applications.  The menues are constructed to be sensitive to whatever you have selected.  The menu items are very different if you have something selected and if you don''t (as context sensitively appropriate).  The methods associated with the items in the variable list menu are in the ''variable menu methods'' protocol.  Likewise for the protocol list and the selector list.  The comments for these methods will explain their purpose.
  447.  
  448. Instance of this class support an interface that allows manipulation of the representation as easily as the behavior.  A ListView shows the instance variables (when viewing the instance methods) or the class variables (when viewing the class methods).
  449.  
  450. Future work:
  451.     - finish all unimplemented menu items.
  452.     - allow manipulation of class instance variables and pool variables in the variables list.
  453.     - allow ''and copy it here...'' of methods between classes.
  454.     - add ''Inherited'' check button
  455.     - replace sequential prompters with a single dialog
  456.  
  457. Instance Variables:
  458.     variable         <Symbol> The currently selected variable (instance variable or class variable).
  459.     upToObject     <Boolean> Indicates whether to show protocols and methods inherited from Object.
  460.  
  461. Class Variables:
  462.     TakenMethod    <Array> The class and the message selector that was last ''taken'' by the ''take it'' menu item.
  463.  
  464. '!
  465.  
  466.  
  467. !ClassBrowser methodsFor: 'protocol list'!
  468.  
  469. allProtocolList
  470.  
  471. "Answer the sequenceable collection containing the message categories for the class."
  472. "Currently they are sorted in alphabetical order.  An improvement would be eldest ancestor priority order."
  473.  
  474.     | protocols passedClasses |
  475.  
  476.     (className isNil) ifTrue: [^nil].
  477.  
  478.     protocols := SortedCollection new.
  479.     passedClasses := IdentitySet new.
  480.     self classesUptoObject: [:theClass |
  481.         (theClass organization categories) do: [:cat |
  482.             passedClasses detect: [:class | class organization categories includes: cat] ifNone: [protocols add: cat]].
  483.          passedClasses add: theClass].
  484.  
  485.     ^protocols!
  486.  
  487. isProtocolLocal
  488.  
  489. "Answer whether the current protocol is locally defined in the currently selected class."
  490.  
  491.     ^self isProtocolLocal: protocol!
  492.  
  493. isProtocolLocal: aProtocol
  494.  
  495. "Answer whether aProtocol is locally defined in the currently selected class."
  496.  
  497.     ^self selectedClass organization categories includes: aProtocol!
  498.  
  499. listItemForProtocol: aProtocol
  500.  
  501. "Answer the text representation for aProtocol.  If the protocol is defined in the current class, it will be highlighted."
  502.  
  503.     (self isProtocolLocal: aProtocol)
  504.         ifTrue: [^aProtocol asText allBold]
  505.         ifFalse: [^aProtocol]!
  506.  
  507. menuForProtocols
  508.  
  509.     "Answer a menu of operations on message protocols."
  510.  
  511.     | selectors |
  512.     selectors := #(findMethod updateProtocols browseClassReferences addProtocol) asOrderedCollection.
  513.     (self nonMetaClass superclass isNil)
  514.         ifFalse: [selectors add: #browseSuperclass].
  515.     ^self menuForSelectorPredicates: selectors!
  516.  
  517. menuForSelectedProtocol
  518.  
  519.     "Answer a menu of operations on the selected message protocol."
  520.  
  521.     | selectors |
  522.  
  523.     selectors := #(
  524.         takeSelectedProtocol
  525.         showProtocolSenders
  526.         showProtocolImplementors
  527.         fileSelectedProtocolOut
  528.         printSelectedProtocolOut) asOrderedCollection.
  529.     self canMoveItInThisProtocol ifTrue: [
  530.         selectors add: #andMoveMethodIntoHere].
  531.     self isProtocolLocal ifTrue: [
  532.         selectors addAll: #(renameSelectedProtocol removeSelectedProtocol)].
  533.     ^self menuForSelectorPredicates: selectors objectOfVerbs: #selectedProtocol!
  534.  
  535. newProtocolList: initialSelection
  536.  
  537. "Update the protocol list.  Set the currently selected message category to be initialSelection."
  538.  
  539.     super newProtocolList: initialSelection.
  540.     self changed: #protocolItem!
  541.  
  542. protocolItem
  543.  
  544. "Answer the receiver's currently selected protocol list item."
  545.  
  546.     (self protocol isNil)
  547.         ifTrue: [^nil]
  548.         ifFalse: [^self listItemForProtocol: self protocol]!
  549.  
  550. protocolItem: selection
  551.  
  552. "Set the receiver's currently selected protocol to be selection and update the message selector list."
  553.  
  554.     (selection isNil)
  555.         ifTrue: [self protocol: nil]
  556.         ifFalse: [self protocol: selection string].
  557.     self changed: #selectorItem!
  558.  
  559. protocolList
  560.  
  561. "Answer the sequenceable collection containing the message categories for aClass."
  562.  
  563.     (className isNil) ifTrue: [^nil].
  564.     ^(self allProtocolList) collect: [:each |
  565.         self listItemForProtocol: each]!
  566.  
  567. protocolMenu
  568.  
  569. "Answer an menu of operations on message categories to be displayed when the operate menu button is pressed."
  570.  
  571.     protocol isNil
  572.         ifTrue: [^self menuForProtocols]
  573.         ifFalse: [^self menuForSelectedProtocol]! !
  574.  
  575. !ClassBrowser methodsFor: 'selector list'!
  576.  
  577. newSelectorList: initialSelection
  578.  
  579. "Establish a new selector list and set the currently selected message selector to be initialSelection."
  580.  
  581.     super newSelectorList: initialSelection.
  582.     self changed: #selectorItem!
  583.  
  584. selectorItem
  585.  
  586. "Answer the receiver's currently selected message selector list item."
  587.  
  588.     (self selector isNil)
  589.         ifTrue: [^nil]
  590.         ifFalse: [^self listItemForSelector: self selector]!
  591.  
  592. selectorItem: selection 
  593.  
  594. "Set the receiver's currently selected message selector item to be selection."
  595.  
  596.     (selection isNil)
  597.         ifTrue: [self selector: nil]
  598.         ifFalse: [self selector: selection string]!
  599.  
  600. selectorItemList
  601.  
  602. "Answer the sequenceable collection containing the message selectors list items that the receiver accesses via the current message category."
  603.  
  604.     (protocol isNil) ifTrue: [^nil].
  605.     ^self selectorList collect: [:each | self listItemForSelector: each]!
  606.  
  607. selectorMenu
  608.  
  609. "Answer an menu of operations on message selectors to be displayed when the operate menu button is pressed."
  610.  
  611.     | selectors |
  612.  
  613.     selector isNil ifTrue: [^nil].
  614.     selectors := OrderedCollection new.
  615.     (self selectedClass isMeta) & (selector numArgs = 0) ifTrue: [
  616.         selectors add: #doMethod].
  617.     (self isSelectorLocal)
  618.         ifTrue: [
  619.             selectors addAll: #(
  620.                 takeSelectedMethod
  621.                 spawnMethod
  622.                 spawnSuperMethod
  623.                 fileSelectedMethodOut
  624.                 printSelectedMethodOut
  625.                 removeSelectedMethod)]
  626.         ifFalse: [selectors add: #spawnMethodImplementor].
  627.     selectors addAll: #(
  628.         browseSenders
  629.         browseImplementors
  630.         browseMessages
  631.         browseSelfSenders
  632.         browseOverrides
  633.         browseSelfMessages).
  634.  
  635.     ^self menuForSelectorPredicates: selectors objectOfVerbs: #selectedMethod! !
  636.  
  637. !ClassBrowser methodsFor: 'text'!
  638.  
  639. acceptText: aText from: aController
  640.  
  641. "Text has been changed.  Store or compile the text, depending on the current mode of the receiver."
  642.  
  643.     (textMode == #methodDefinition) ifTrue: [^self acceptMethod: aText from: aController].
  644.  
  645.     (variable isNil or: [self variableIsLocal])
  646.         ifTrue: [
  647.             self nonMetaClass comment: aText string.
  648.             ^true]
  649.         ifFalse: [
  650.             ^false]!
  651.  
  652. text
  653.  
  654.     "Answer the text to be shown in the text view."
  655.  
  656.     | comment |
  657.     (className isNil) ifTrue: [^Text new].
  658.     (textMode = #methodDefinition) ifTrue: [^self textForMethodDefinition].
  659.     self nonMetaClass isNil ifTrue: [^Text new].
  660.     (variable notNil and: [self variableIsLocal not])
  661.         ifTrue: [comment := self textForVariableComment]
  662.         ifFalse: [comment := self textForClassComment].
  663.     comment isNil
  664.         ifTrue: [comment := 'This class has no comment'].
  665.     ^comment asText!
  666.  
  667. textForClassComment
  668.  
  669.     "Answer the text to be shown in the text view for the class comment."
  670.  
  671.     ^self nonMetaClass comment!
  672.  
  673. textForMethodDefinition
  674.  
  675.     "Answer the text of the method definition for the selected method."
  676.  
  677.     | theClass |
  678.     (selector == nil) ifTrue: [^self selectedClass sourceCodeTemplate asText].
  679.     theClass := self selectorDefiningClass.
  680.     theClass isNil ifTrue: [^'This selector no longer exists'].
  681.     ^(theClass sourceCodeAt: selector) asText makeSelectorBoldIn: self selectedClass!
  682.  
  683. textForVariableComment
  684.  
  685.     "Answer the text to be shown in the text view for the class comment of the class declaring the selected variable."
  686.  
  687.     | theClass |
  688.     theClass := self variableDeclaringClass.
  689.     theClass isNil ifTrue: [
  690.         ^'This variable no longer exists.'].
  691.     theClass isMeta ifTrue: [theClass := theClass soleInstance].
  692.     ^(variable, ' from ', theClass name, ':') asText allBold,
  693.         (String with: Character cr with: Character cr) asText, theClass comment asText!
  694.  
  695. textMenu
  696.  
  697. "Answer an menu of operations on the text that is to be displayed when the operate menu button is pressed."
  698.  
  699.     | selectors |
  700.  
  701.     selectors := #(
  702.         again
  703.         undo
  704.         copySelection
  705.         cut paste
  706.         doIt
  707.         printIt
  708.         inspectIt
  709.         accept
  710.         cancel
  711.         format:from:).
  712.  
  713.     ^self menuForSelectorPredicates: selectors objectOfVerbs: 'selection'!
  714.  
  715. updateText
  716.  
  717.     "Cause the text view to be updated."
  718.  
  719.     self changed: #text! !
  720.  
  721. !ClassBrowser methodsFor: 'variables list'!
  722.  
  723. classVariablesMenu
  724.  
  725.     "Answer a menu for the class variables list."
  726.  
  727.     | selectors |
  728.  
  729.     (variable isNil) ifTrue: [
  730.         ^self menuForSelectorPredicates: #(addClassVariable addClassInstanceVariable addPoolDictionary updateVariables)].
  731.     selectors := OrderedCollection with: #browseReferencesToSelectedVariable.
  732.     (self variableIsLocal)
  733.         ifTrue: [selectors addLast: #removeSelectedVariable]
  734.         ifFalse: [selectors addLast: #showClassDefiningSelectedVariable].
  735.     ^self menuForSelectorPredicates: selectors objectOfVerbs: #selectedVariable!
  736.  
  737. instanceVariablesMenu
  738.  
  739.     "Answer a menu for the instance variables list."
  740.  
  741.     | selectors |
  742.  
  743.     (variable isNil) ifTrue: [
  744.         ^self menuForSelectorPredicates: #(addInstanceVariable updateVariables)].
  745.     selectors := OrderedCollection with: #browseReferencesToSelectedVariable.
  746.     (self variableIsLocal)
  747.         ifTrue: [selectors addLast: #removeSelectedVariable]
  748.         ifFalse: [selectors addLast: #showClassDefiningSelectedVariable].
  749.     ^self menuForSelectorPredicates: selectors objectOfVerbs: #selectedVariable!
  750.  
  751. newVariableList: initialSelection
  752.  
  753.     "Set the currently selected message category to be initialSelection."
  754.  
  755.     variable := initialSelection.
  756.     self changed: #variable!
  757.  
  758. variable
  759.  
  760. "Answer the receiver's currently selected variable."
  761.  
  762.     (variable isNil)
  763.         ifTrue: [^nil]
  764.         ifFalse: [^self variableListItem: variable]!
  765.  
  766. variable: selection
  767.  
  768. "Set the receiver's currently selected variable to be selection."
  769.  
  770.     (selection isNil)
  771.         ifTrue: [
  772.             variable := nil.
  773.             self updateText]
  774.         ifFalse: [
  775.             variable := selection string.
  776.             self textMode: #comment]!
  777.  
  778. variableList
  779.  
  780. "Answer the sequenceable collection containing the variables for aClass."
  781.  
  782.     | variables |
  783.  
  784.     (className isNil) ifTrue: [^nil].
  785.  
  786.     variables := SortedCollection new.
  787.     self classesUptoObject: [:eachClass |
  788.         "eachClass isMeta
  789.             ifTrue: [variables addAll: eachClass soleInstance classVarNames]
  790.             ifFalse: [variables addAll: eachClass instVarNames]"
  791.         variables addAll: (self variablesOf: eachClass)].
  792.     ^variables collect: [:each | self variableListItem: each]!
  793.  
  794. variableListItem: aVariable
  795.  
  796. "Answer the text representation for aVariable.  If the variable is defined in the current class, it will be highlighted."
  797.  
  798.     (self variableIsLocal: aVariable) 
  799.         ifTrue: [^aVariable asText allBold]
  800.         ifFalse: [^aVariable]!
  801.  
  802. variablesMenu
  803.  
  804.     "Answer a menu of operations on the variables list."
  805.  
  806.     (self meta)
  807.         ifTrue: [^self classVariablesMenu]
  808.         ifFalse: [^self instanceVariablesMenu]! !
  809.  
  810. !ClassBrowser methodsFor: 'meta (class/inst) switch'!
  811.  
  812. meta: ignored
  813.  
  814. "Toggle whether to show the class or instance representation/behavior."
  815.  
  816.     self changeRequest ifFalse: [^self changed: #meta].
  817.     meta := meta not.
  818.     self changed: #meta.
  819.     self newVariableList: variable.
  820.     self newProtocolList: protocol.
  821.     self classMode ifTrue: [self changed: #text]! !
  822.  
  823. !ClassBrowser methodsFor: 'upToObject switch'!
  824.  
  825. upToObject
  826.  
  827. "Answer if I am viewing the behavior inclusive of Object."
  828.  
  829.     ^upToObject!
  830.  
  831. upToObject: ignored
  832.  
  833. "Toggle whether I am viewing the behavior inclusive of Object."
  834.  
  835.     self changeRequest ifFalse: [^self changed: #upToObject].
  836.     upToObject := upToObject not.
  837.     self changed: #upToObject.
  838.     self newVariableList: variable.
  839.     self newProtocolList: protocol! !
  840.  
  841. !ClassBrowser methodsFor: 'protocol menu methods'!
  842.  
  843. andMoveItInThisProtocol
  844.  
  845.     "Take the last taken method and move it into this protocol (of the same class).  Do the same to all subclasses who also define this same method."
  846.  
  847.     self selectedClass withAllSubclasses do: [:eachClass |
  848.         (eachClass includesSelector: (TakenMethod at: 2)) ifTrue: [
  849.             eachClass copy: (TakenMethod at: 2) from: eachClass classified: self protocol
  850.             "eachClass organization classify: (TakenMethod at: 2) under: self protocol.
  851.             self logProtocolChange: eachClass name, ' organization classify: ',
  852.                 (TakenMethod at: 2) storeString, ' under: ', self protocol storeString.
  853.             eachClass reorganize"]].
  854.     self newProtocolList: self protocol.
  855.     self newSelectorList: (TakenMethod at: 2)!
  856.  
  857. andMoveMethodIntoHere
  858.  
  859.     "Move the taken method into this protocol (of the same class)."
  860.  
  861.     self selectedClass withAllSubclasses do: [:eachClass |
  862.         (eachClass includesSelector: (TakenMethod at: 2)) ifTrue: [
  863.             eachClass organization classify: (TakenMethod at: 2) under: self protocol.
  864.             self logProtocolChange: eachClass name, ' organization classify: ',
  865.                 (TakenMethod at: 2) storeString, ' under: ', self protocol storeString.
  866.             eachClass reorganize]].
  867.     self newSelectorList: (TakenMethod at: 2)!
  868.  
  869. browseSuperclass
  870.  
  871. "Browse the implementation of the selected class's superclass"
  872.  
  873.     self class newOnClass: self nonMetaClass superclass!
  874.  
  875. fileSelectedProtocolOut
  876.  
  877.     "File out the currently selected protocol.  Prompt the user for the file name and whether or not to include inherited methods."
  878.  
  879.     | fileName |
  880.  
  881.     fileName := DialogView
  882.         requestNewFileName: 'File out on'
  883.         default: (self filterFilename: self selectedClass name, '-', protocol, '.st'). 
  884.     (fileName = '') ifTrue: [^nil].
  885.     self fileSelectedProtocolOutOnFile: fileName!
  886.  
  887. findMethod
  888.  
  889.     "Prompt for a method and show it.  Generalize the match string if necessary to find a matching Method."
  890.  
  891.     | originalName matchString matchStream |
  892.  
  893.     self changeRequest ifFalse: [^self].
  894.     originalName := DialogView request: 'Pick a method:' initialAnswer: '*'. 
  895.     (originalName isEmpty) ifTrue: [^nil].
  896.     (self findMethodMatching: originalName) = false ifFalse: [^self].
  897.     matchString := originalName.
  898.     "Try and find a selector starting with the string that was entered."
  899.     (matchString last = $*) ifFalse: [
  900.         matchString := matchString, '*'.
  901.         (self findMethodMatching: matchString) = false ifFalse: [^self]].
  902.     "Try and find a selector having the string that was entered somewhere in it."
  903.     (matchString first = $*) ifFalse: [
  904.         matchString := '*', matchString.
  905.         (self findMethodMatching: matchString) = false ifFalse: [^self]].
  906.     "Try and find a selector having the selector pieces entered somewhere in it."
  907.     matchStream := WriteStream on: (String new: matchString size * 2).
  908.     matchString do: [:character |
  909.         character isUppercase
  910.             ifTrue: [matchStream nextPut: $*].
  911.         matchStream nextPut: character].
  912.     (self findMethodMatching: matchStream contents) = false ifFalse: [^self].
  913.     "Try and find a selector having at least the capital letters that were entered somewhere in it."
  914.     matchStream := WriteStream on: (String new: matchString size * 2).
  915.     matchStream nextPut: $*; nextPut: originalName first.
  916.     matchString do: [:character |
  917.         character isUppercase ifTrue: [
  918.             matchStream nextPut: $*; nextPut: character]].
  919.     matchStream nextPut: $*.
  920.     (self findMethodMatching: matchStream contents) = false ifFalse: [^self].
  921.     "Last ditch effort, find whatever selector is spelled as closely to what was originally entered."
  922.     self findMethodSpelledLike: originalName!
  923.  
  924. printSelectedProtocolOut
  925.  
  926.     "Print out the currently selected protocol."
  927.     "Use the printOutProtocol from Browser."
  928.  
  929.     super printOutProtocol!
  930.  
  931. removeSelectedProtocol
  932.  
  933.     "Remove the selected protocol from the class and all methods locally defined in that class."
  934.  
  935.     | selectors |
  936.     self changeRequest ifFalse: [^self].
  937.     selectors := self selectedClass organization listAtCategoryNamed: protocol.
  938.     selectors isEmpty ifFalse:
  939.         [(DialogView confirm: 'Are you certain that you want to
  940. remove all methods in this protocol?') ifFalse: [^self].
  941.         selectors do: [:sel | self selectedClass removeSelector: sel]].
  942.     self selectedClass organization removeCategory: protocol.
  943.     self logProtocolChange: self selectedClass name, ' organization removeCategory: ', protocol storeString.
  944.     self selectedClass reorganize.
  945.     self newProtocolList: protocol!
  946.  
  947. showProtocolImplementors
  948.  
  949. "Show the classes implementing the currently selected protocol."
  950.  
  951.     DialogView warn: 'showProtocolImplementors has not been implemented yet.'!
  952.  
  953. showProtocolSenders
  954.  
  955. "Show the senders of messages in the currently selected protocol."
  956.  
  957.     DialogView warn: 'showProtocolSenders has not been implemented yet.'!
  958.  
  959. takeSelectedProtocol
  960.  
  961.     "Take the selected protocol in preparation for copying it to another class."
  962.  
  963.     DialogView warn: 'takeSelectedProtocol has not been implemented yet.'!
  964.  
  965. updateProtocols
  966.  
  967. "Update the list of protocols."
  968.  
  969.     self changeRequest ifFalse: [^self].
  970.     self newProtocolList: protocol! !
  971.  
  972. !ClassBrowser methodsFor: 'selector menu methods'!
  973.  
  974. acceptMethod: aText from: aController
  975.  
  976. "Accept aText (defining a new method) from aController."
  977. "Had to override to ensure that the selector list is updated in case I am overriding."
  978.  
  979.     | newSelector |
  980.     newSelector := self selectedClass
  981.                 compile: aText
  982.                 classified: protocol
  983.                 notifying: aController.
  984.     newSelector == nil ifTrue: [^false].
  985.     self newSelectorList: newSelector.
  986.     self newProtocolList: protocol.
  987.     ^true!
  988.  
  989. browseMessages
  990.  
  991. "Browse the messages sent by the currently selected method."
  992.  
  993.     self class showMenuThenBrowse:
  994.         (self selectorDefiningClass compiledMethodAt: selector)
  995.             messages asSortedCollection!
  996.  
  997. browseOverrides
  998.  
  999.     "Browse all subclasses which override the selected message."
  1000.  
  1001.     | aCollection |
  1002.  
  1003.     aCollection := SortedCollection new.
  1004.     self selectorDefiningClass allSubclasses do: [:class |
  1005.         (class includesSelector: selector)
  1006.             ifTrue: [aCollection add: class name, ' ', selector]].
  1007.  
  1008.     MethodListBrowser
  1009.         openListBrowserOn: aCollection
  1010.         label: 'Overriders of ', self selectorDefiningClass name, ' ', selector!
  1011.  
  1012. browseSelfMessages
  1013.  
  1014. "Browse the messages sent by the currently selected method that the currently selected class understands."
  1015.  
  1016.     | messages choice definingClass |
  1017.     self changeRequest ifFalse: [^self].
  1018.     messages := (self selectorDefiningClass compiledMethodAt: selector) messages.
  1019.     messages := (messages select: [:message | self selectedClass canUnderstand: message]) asSortedCollection.
  1020.     messages isEmpty ifTrue: [^self].
  1021.     choice := (PopUpMenu labelList: (Array with: messages)) startUp.
  1022.     choice = 0 ifTrue: [^self].
  1023.     definingClass := self selectedClass whichClassIncludesSelector: (messages at: choice).
  1024.     ((definingClass = Object) | (self meta & (definingClass = Object class))) & self upToObject not
  1025.         ifTrue: [self upToObject: true].
  1026.     self newProtocolList: (self protocolOf: (messages at: choice)).
  1027.     self newSelectorList: (messages at: choice)!
  1028.  
  1029. browseSelfSenders
  1030.  
  1031. "Browse all methods that call the currently selected method by sending the message to 'self' or 'super'.  All such methods will be in one of the superclasses or in one of the subclasses."
  1032.  
  1033.     "I can't determine fast enough yet whether the message selector is REALLY being sent to 'self' or 'super' so instead I will browse any method that sends the message selector and COULD be sending it to 'self' or 'super' to invoke the method in question.  I am still considering whether it is useful to weed out methods that couldn't invoke the method directly (even via super) because of intervening over-riders."
  1034.  
  1035.     | senders definingClass |
  1036.  
  1037.     senders := OrderedCollection new.
  1038.     definingClass := self selectorDefiningClass.
  1039.     definingClass allSuperclasses reverse, definingClass withAllSubclasses do: [:eachClass |
  1040.         eachClass selectors do: [:eachSelector |
  1041.             ((eachClass compiledMethodAt: eachSelector) refersToLiteral: selector) ifTrue: [
  1042.                 senders add: eachClass name, ' ', eachSelector]]].
  1043.     MethodListBrowser
  1044.         openListBrowserOn: senders
  1045.         label: 'self senders of ', self selectorDefiningClass name, ' ', selector
  1046.         initialSelection: selector!
  1047.  
  1048. doMethod
  1049.  
  1050. "Do the selected method."
  1051.  
  1052.     self nonMetaClass perform: selector!
  1053.  
  1054. fileSelectedMethodOut
  1055.  
  1056.     "File out the selected method.  Prompt for the name of the file to use."
  1057.     "Use fileOutMessage from Browser."
  1058.  
  1059.     super fileOutMessage!
  1060.  
  1061. printSelectedMethodOut
  1062.  
  1063.     "Print out the selected method."
  1064.     "Use printOutMessage from Browser."
  1065.  
  1066.     super printOutMessage!
  1067.  
  1068. removeSelectedMethod
  1069.  
  1070.     "Remove the selected method from the class."
  1071.  
  1072.     (self changeRequest and: [DialogView confirm: 'Are you certain that you
  1073. want to remove this method?'])
  1074.         ifTrue: 
  1075.             [self selectedClass removeSelector: selector.
  1076.             self newSelectorList: selector.
  1077.             (self selectedClass organization listAtCategoryNamed: protocol) isEmpty
  1078.                 ifTrue: [self removeSelectedProtocol]
  1079.                 ifFalse: [self newProtocolList: protocol].
  1080.             ^ true].
  1081.     ^ false!
  1082.  
  1083. renameSelectedProtocol
  1084.  
  1085.     "Rename the selected Protocol."
  1086.     "Use the renameProtocol method from Browser."
  1087.  
  1088.     super renameProtocol!
  1089.  
  1090. spawnMethodImplementor
  1091.  
  1092. "Spawn an implementation browser on the selected method."
  1093.  
  1094.     self class newOnClass: self selectorDefiningClass selector: self selector!
  1095.  
  1096. spawnSuperMethod
  1097.  
  1098.     "Spawn an implementation browser on the super version of the selected method."
  1099.  
  1100.     | superMethodClass |
  1101.  
  1102.     (self selectedClass superclass notNil)
  1103.         ifTrue: [superMethodClass := self selectedClass superclass whichClassIncludesSelector: selector].
  1104.  
  1105.     (superMethodClass notNil)
  1106.         ifTrue: [MethodListBrowser openMethodBrowserOn: (self copy onClass: superMethodClass)]!
  1107.  
  1108. takeSelectedMethod
  1109.  
  1110.     "Take the currently selected method (in preparation for moving or copying it to another protocol or class)."
  1111.  
  1112.     TakenMethod := Array with: self selectorDefiningClass name with: self selector! !
  1113.  
  1114. !ClassBrowser methodsFor: 'class support'!
  1115.  
  1116. classesAndSelectorsUptoObject: aBlock
  1117.  
  1118. "Evaluate aBlock will all the classes upto Object (inclusive of Object if that flag is set) and with the collection of message selectors from that class that are in the selected protocol and are responders to messages to the selectedClass."
  1119.  
  1120.     | passedClasses |
  1121.  
  1122.     passedClasses := IdentitySet new.
  1123.     self classesUptoObject: [:theClass | | selectors |
  1124.         selectors := OrderedCollection new.
  1125.         (theClass organization listAtCategoryNamed: protocol) do: [:sel |
  1126.             passedClasses
  1127.                 detect: [:class | class includesSelector: sel]
  1128.                 ifNone: [selectors add: sel]].
  1129.         aBlock value: theClass value: selectors.
  1130.         passedClasses add: theClass]!
  1131.  
  1132. classesUptoObject: aBlock
  1133.  
  1134. "Evaluate aBlock will all the classes upto Object (inclusive of Object if that flag is set)."
  1135.  
  1136.     | theClass stopClass |
  1137.  
  1138.     (self upToObject)
  1139.         ifTrue: [stopClass := nil]
  1140.         ifFalse: [
  1141.             (self meta)
  1142.                 ifTrue: [stopClass := (Smalltalk at: #Object) class]
  1143.                 ifFalse: [stopClass := (Smalltalk at: #Object)]].
  1144.  
  1145.     theClass := self selectedClass.
  1146.     [aBlock value: theClass.
  1147.      (theClass == stopClass) | (theClass superclass == stopClass)]
  1148.         whileFalse: [theClass := theClass superclass]! !
  1149.  
  1150. !ClassBrowser methodsFor: 'variables menu methods'!
  1151.  
  1152. addClassVariable
  1153.  
  1154.     "Prompt for and add a class variable to the class."
  1155.  
  1156.     | aString newVariable |
  1157.  
  1158.     self changeRequest ifFalse: [^self].
  1159.     aString := self prompt: 'Enter new class variable name' initially: ''.
  1160.     aString isEmpty ifTrue: [^self].
  1161.     newVariable := (Scanner new) scanFieldNames: aString.
  1162.     newVariable isEmpty ifTrue: [^self].
  1163.     newVariable := newVariable first.
  1164.     newVariable at: 1 put: newVariable first asUppercase.
  1165.     self nonMetaClass addClassVarName: newVariable.
  1166.     SourceFileManager default logChange: self nonMetaClass name, ' addClassVarName: ', newVariable printString.
  1167.     ChangeSet current changeClass: self nonMetaClass.
  1168.     self newVariableList: newVariable!
  1169.  
  1170. addInstanceVariable
  1171.  
  1172.     "Prompt for and add an instance variable to the class."
  1173.  
  1174.     | aString newVariable |
  1175.  
  1176.     self changeRequest ifFalse: [^self].
  1177.     aString := self prompt: 'Enter new instance variable name' initially: ''.
  1178.     aString isEmpty ifTrue: [^self].
  1179.     newVariable := (Scanner new) scanFieldNames: aString.
  1180.     newVariable isEmpty ifTrue: [^self].
  1181.     newVariable := newVariable first.
  1182.     newVariable at: 1 put: newVariable first asLowercase.
  1183.     self nonMetaClass addInstVarName: newVariable.
  1184.     SourceFileManager default logChange: self nonMetaClass name, ' addInstVarName: ', newVariable printString.
  1185.     ChangeSet current changeClass: self nonMetaClass.
  1186.     self newVariableList: newVariable!
  1187.  
  1188. browseReferencesToSelectedVariable
  1189.  
  1190.     "Browse methods that access the currently selected variable."
  1191.  
  1192.     (self meta)
  1193.         ifFalse: [self browseReferencesToSelectedInstanceVariable]
  1194.         ifTrue: [self browseReferencesToSelectedClassVariable]!
  1195.  
  1196. removeSelectedVariable
  1197.  
  1198.     "Remove the selected variable from the class."
  1199.  
  1200.     (self changeRequest and: [DialogView confirm: 'Are you certain that you
  1201. want to remove this variable?']) ifFalse: [^nil].
  1202.  
  1203.     (self meta)
  1204.         ifFalse: [
  1205.             self nonMetaClass removeInstVarName: variable.
  1206.             SourceFileManager default logChange: self nonMetaClass name, ' removeInstVarName: ', variable asString printString]
  1207.         ifTrue: [
  1208.             self nonMetaClass removeClassVarName: variable.
  1209.             SourceFileManager default logChange: self nonMetaClass name, ' removeClassVarName: ', variable asString printString].
  1210.     ChangeSet current changeClass: self nonMetaClass.
  1211.     self newVariableList: nil!
  1212.  
  1213. showClassDefiningSelectedVariable
  1214.  
  1215.     "Show the class that declares the currently selected variable."
  1216.  
  1217.     self class newOnClass: self variableDeclaringClass!
  1218.  
  1219. updateVariables
  1220.  
  1221. "Update the variables list."
  1222.  
  1223.     self changeRequest ifFalse: [^self].
  1224.     self newVariableList: variable! !
  1225.  
  1226. !ClassBrowser methodsFor: 'view creation'!
  1227.  
  1228. addButtonsViewTo: aView in: area
  1229.  
  1230.     "Add a composite view with all the buttons (instance/class button and upTo Object button)"
  1231.  
  1232.     | view composite baseModel |
  1233.  
  1234.     composite := CompositePart new.
  1235.     baseModel := (PluggableAdaptor on: self) getSelector: #meta putSelector: #meta:.
  1236.     view := Button toggle label: 'instance';
  1237.         model: ((PluggableAdaptor on: baseModel) selectValue: false).
  1238.     composite add: view in: (LayoutFrame new leftOffset: 2; rightFraction: 1; rightOffset: -2; topOffset: 1; bottomFraction: 0.5; bottomOffset: -1).
  1239.     view := Button toggle label: 'class';
  1240.         model: ((PluggableAdaptor on: baseModel) selectValue: true).
  1241.     composite add: view in: (LayoutFrame new leftOffset: 2; rightFraction: 0.5; topFraction: 0.5; bottomFraction: 1; bottomOffset: -1).
  1242.     baseModel := (PluggableAdaptor on: self) getSelector: #upToObject putSelector: #upToObject:.
  1243.     view := Button switch model: baseModel; label: 'Object'.
  1244.     composite add: view in: (LayoutFrame new leftFraction: 0.5; leftOffset: 3; rightFraction: 1; topFraction: 0.5; bottomFraction: 1; bottomOffset: -1).
  1245.     aView add: composite in: area!
  1246.  
  1247. addProtocolViewTo: aView in: area
  1248.  
  1249. "Add the view to aView showing the instances protocols (implementation)."
  1250.  
  1251.     aView add: (LookPreferences edgeDecorator on:
  1252.         (SelectionInListView on: self
  1253.             aspect: #protocolItem change: #protocolItem:
  1254.             list: #protocolList menu: #protocolMenu
  1255.             initialSelection: #protocolItem))
  1256.             in: area!
  1257.  
  1258. addSelectorViewTo: aView in: area
  1259.  
  1260. "Add the view allowing selection of selectors."
  1261.  
  1262.     aView add: (LookPreferences edgeDecorator on:
  1263.         (SelectionInListView on: self
  1264.             aspect: #selectorItem change: #selectorItem:
  1265.             list: #selectorItemList menu: #selectorMenu
  1266.             initialSelection: #selectorItem))
  1267.         in: area!
  1268.  
  1269. addTextViewTo: aView in: area
  1270.  
  1271. "Add a text view allowing manipulation of text like methods."
  1272.  
  1273.     aView add: (LookPreferences edgeDecorator on:
  1274.         (TextView on: self
  1275.             aspect: #text change: #acceptText:from:
  1276.             menu: #textMenu))
  1277.         in: area!
  1278.  
  1279. addVariableViewTo: aView in: area
  1280.  
  1281. "Add the view showing the variables (either class or instance variables) to myself."
  1282.  
  1283.     aView add: (LookPreferences edgeDecorator on:
  1284.         (SelectionInListView on: self
  1285.             aspect: #variable change: #variable:
  1286.             list: #variableList menu: #variablesMenu
  1287.             initialSelection: #variable))
  1288.         in: area!
  1289.  
  1290. open
  1291.  
  1292. "Open a view onto the receiver."
  1293.  
  1294.     | window topView buttonHeight |
  1295.  
  1296.     window := ScheduledWindow model: self label: self className minimumSize: 450@250.
  1297.     topView := CompositePart new.
  1298.     window component: topView.
  1299.     buttonHeight := 18.
  1300.     self
  1301.         addButtonsViewTo: topView in: (LayoutFrame new
  1302.             rightFraction: 1/4;
  1303.             bottomOffset: buttonHeight * 2);
  1304.         addVariableViewTo: topView in: (LayoutFrame new
  1305.             rightFraction: 1/4;
  1306.             topOffset: buttonHeight * 2;
  1307.             bottomFraction: 0.3);
  1308.         addProtocolViewTo: topView in: (LayoutFrame new
  1309.             leftFraction: 1/4;
  1310.             rightFraction: 7/12;
  1311.             bottomFraction: 0.3);
  1312.         addSelectorViewTo: topView in: (LayoutFrame new
  1313.             leftFraction: 7/12;
  1314.             rightFraction: 1;
  1315.             bottomFraction: 0.3);
  1316.         addTextViewTo: topView in: (LayoutFrame new
  1317.             rightFraction: 1;
  1318.             bottomFraction: 1;
  1319.             topFraction: 0.3).
  1320.     window openWithExtent: 550@350! !
  1321.  
  1322. !ClassBrowser methodsFor: 'initialize'!
  1323.  
  1324. onClass: aClass 
  1325.  
  1326. "Set the receiver to be a browser on the class aClass."
  1327.  
  1328.     super onClass: aClass.
  1329.     upToObject := false!
  1330.  
  1331. onClass: aClass selector: aSelector
  1332.  
  1333.     "Set the receiver to be a browser on the class aClass.  Initially showing aSelector (or nil)."
  1334.  
  1335.     self onClass: aClass.
  1336.     upToObject := false.
  1337.     aSelector notNil ifTrue: [
  1338.         self protocol: (self protocolOf: aSelector).
  1339.         self selector: aSelector]! !
  1340.  
  1341. !ClassBrowser methodsFor: 'menu contruction support'!
  1342.  
  1343. menuForSelectorPredicates: selectorPredicates
  1344.  
  1345.     "Answer a menu appropriate for the given collection of selectorPredicates (selectors which are predicate phrases)"
  1346.     "This behavior should exist in PopUpMenu.  And PopUpMenu should be generalized since a menu is a more general concept than a PopUpMenu."
  1347.  
  1348.     "This functionality is currently implemented by my class."
  1349.     ^self class menuForSelectorPredicates: selectorPredicates!
  1350.  
  1351. menuForSelectorPredicates: selectorPredicates objectOfVerbs: objectOfVerbs
  1352.  
  1353.     "Answer a menu appropriate for the given collection of message selectors and with objectOfVerbs (a String) implied in the menu labels. If objectOfVerbs is nil then the labels will be generated without a objectOfVerbs."
  1354.     "The objectOfVerbs will be replaced by 'it' in the labels."
  1355.     "This behavior should exist in PopUpMenu.  And PopUpMenu should be generalized since a menu is a more general concept than a PopUpMenu."
  1356.  
  1357.     ^self class menuForSelectorPredicates: selectorPredicates objectOfVerbs: objectOfVerbs! !
  1358.  
  1359. !ClassBrowser methodsFor: 'selector list support'!
  1360.  
  1361. availableSelectorsWhich: aBlock
  1362.  
  1363. "Answer the set containing the message selectors that the current class defines (upto object if that flag is set)."
  1364.  
  1365.     | selectors |
  1366.  
  1367.     selectors := Set new.
  1368.     self classesUptoObject: [:class |
  1369.         (class selectors) do: [:aSelector |
  1370.             (aBlock value: aSelector) ifTrue: [selectors add: aSelector]]].
  1371.     ^selectors!
  1372.  
  1373. isSelectorLocal
  1374.  
  1375. "Answer whether the currently selected message selector is locally defined."
  1376.  
  1377.     ^self isSelectorLocal: selector!
  1378.  
  1379. isSelectorLocal: aSelector
  1380.  
  1381. "Answer whether aSelector is locally defined."
  1382.  
  1383.     ^self selectedClass includesSelector: aSelector!
  1384.  
  1385. listItemForSelector: aSelector
  1386.  
  1387. "Answer the text for aSelector in the list.  If the selector is locally defined, it will be highlighted."
  1388.  
  1389.     ^(self isSelectorLocal: aSelector)
  1390.         ifTrue: [aSelector asText allBold]
  1391.         ifFalse: [aSelector]!
  1392.  
  1393. selectorDefiningClass
  1394.  
  1395.     "Answer the class that defines the current selector."
  1396.  
  1397.     ^self selectedClass whichClassIncludesSelector: selector!
  1398.  
  1399. selectorList
  1400.  
  1401. "Answer the sequenceable collection containing the message selectors that the receiver accesses via the current message category."
  1402.  
  1403.     | selectors |
  1404.  
  1405.     selectors := SortedCollection new.
  1406.     self classesAndSelectorsUptoObject: [:eachClass :selectorCollection |
  1407.         selectors addAll: selectorCollection].
  1408.     ^selectors! !
  1409.  
  1410. !ClassBrowser methodsFor: 'protocol list support'!
  1411.  
  1412. canMoveItInThisProtocol
  1413.  
  1414. "Answer if the last taken method can be moved into this protocol."
  1415.  
  1416.     TakenMethod isNil ifTrue: [^false].
  1417.     self selectedClass name = (TakenMethod at: 1) ifFalse: [^false].
  1418.     (self selectedClass includesSelector: (TakenMethod at: 2)) ifFalse: [^false].
  1419.     (self selectedClass whichCategoryIncludesSelector: (TakenMethod at: 2)) = self protocol ifTrue: [^false].
  1420.     ^true!
  1421.  
  1422. fileSelectedProtocolOutOnFile: fileName
  1423.  
  1424.     "File out the currently selected protocol on the specified fileName.  Prompt the user for the file name and whether or not to include inherited methods."
  1425.  
  1426.     | fileStream includeInherited |
  1427.  
  1428.     includeInherited := DialogView confirm: 'Include any inherited methods?'.
  1429.     fileStream := SourceCodeStream on: fileName asFilename writeStream.
  1430.     [fileStream timeStamp.
  1431.      self fileSelectedProtocolOutOnSourceStream: fileStream includeInherited: includeInherited]
  1432.         valueNowOrOnUnwindDo: [fileStream close]!
  1433.  
  1434. fileSelectedProtocolOutOnSourceStream: sourceStream includeInherited: includeInherited
  1435.  
  1436.     "File out the currently selected protocol on the specified sourceStream.  Include inherited methods if includeInhertied is true."
  1437.  
  1438.     (includeInherited)
  1439.         ifTrue: [
  1440.             self classesAndSelectorsUptoObject: [:eachClass :selectorCollection |
  1441.                 sourceStream fileOutMessages: selectorCollection for: eachClass]]
  1442.         ifFalse: [
  1443.             sourceStream fileOutMessages: (self selectedClass organization listAtCategoryNamed: protocol) for: self selectedClass]!
  1444.  
  1445. findMethodMatching: aString
  1446.  
  1447.     "Find a method that matches aString and show it.  Answer true if a matching method was found.  False in not.  nil if matches were found but none were satisfactory to the user."
  1448.  
  1449.     | possibilities newSelector |
  1450.  
  1451.     possibilities := self availableSelectorsWhich: [:aSelector | aString match: aSelector].
  1452.     (possibilities isEmpty) ifFalse: [
  1453.         (possibilities size = 1)
  1454.             ifTrue: [newSelector := possibilities asOrderedCollection first]
  1455.             ifFalse: [ | choice |
  1456.                 possibilities := possibilities asSortedCollection.
  1457.                 choice := (PopUpMenu labelList: (Array with: possibilities)) startUp.
  1458.                 choice isZero ifTrue: [^nil].
  1459.                 newSelector := possibilities at: choice]].
  1460.  
  1461.     newSelector notNil ifTrue: [
  1462.         self newProtocolList: (self protocolOf: newSelector).    
  1463.         self newSelectorList: newSelector.
  1464.         ^true].
  1465.     ^false!
  1466.  
  1467. findMethodSpelledLike: aString
  1468.  
  1469.     "Find the method that most closely matches aString and show it."
  1470.  
  1471.     | bestMatchValue bestMatch possibilities |
  1472.  
  1473.     bestMatchValue := -1.
  1474.     possibilities := self availableSelectorsWhich: [:aSelector | | matchValue |
  1475.         matchValue := aString spellAgainst: aSelector.
  1476.         matchValue > bestMatchValue ifTrue: [
  1477.             bestMatchValue := matchValue.
  1478.             bestMatch := aSelector].
  1479.         matchValue > 40].
  1480.  
  1481.     self newProtocolList: (self protocolOf: bestMatch).    
  1482.     self newSelectorList: bestMatch!
  1483.  
  1484. protocolOf: aSelector
  1485.  
  1486. "Answer the protocol that aSelector is defined in."
  1487.  
  1488.     self classesUptoObject: [:class |
  1489.         (class includesSelector: aSelector) ifTrue: [
  1490.             ^class whichCategoryIncludesSelector: aSelector]].
  1491.     ^nil! !
  1492.  
  1493. !ClassBrowser methodsFor: 'variables list support'!
  1494.  
  1495. browseReferencesToSelectedClassVariable
  1496.  
  1497.     "Browse ethods that access the currently selected class variable."
  1498.  
  1499.     | association theClass |
  1500.  
  1501.     theClass := self nonMetaClass.
  1502.     [(theClass classPool includesKey: variable)
  1503.         ifTrue: [association := theClass classPool associationAt: variable].
  1504.      (association isNil) & (theClass notNil)]
  1505.         whileTrue: [theClass := theClass superclass].
  1506.  
  1507.     (theClass isNil) ifTrue: [^self updateVariables].
  1508.  
  1509.     MethodListBrowser browseAllCallsOn: association within: theClass!
  1510.  
  1511. browseReferencesToSelectedInstanceVariable
  1512.  
  1513.     "Browse methods that access the currently selected instance variable."
  1514.  
  1515.     MethodListBrowser browseAllAccessesTo: variable within: self nonMetaClass!
  1516.  
  1517. selectedClassVariables
  1518.  
  1519. "Answer the variables defined by the currently selected class (or metaClass)."
  1520.  
  1521.     ^self variablesOf: self nonMetaClass!
  1522.  
  1523. variableDeclaringClass
  1524.  
  1525.     "Answer the the class declaring the currently selected variable."
  1526.  
  1527.     self classesUptoObject: [:eachClass |
  1528.         ((self variablesOf: eachClass) includes: variable)
  1529.             ifTrue: [^eachClass]].
  1530.     ^nil!
  1531.  
  1532. variableIsLocal
  1533.  
  1534. "Answer whether the currently selected variable is locally defined."
  1535.  
  1536.     ^self variableIsLocal: variable!
  1537.  
  1538. variableIsLocal: aVariable
  1539.  
  1540. "Answer whether aVariable is locally defined in the currently selected class."
  1541.  
  1542.     ^self selectedClassVariables includes: aVariable!
  1543.  
  1544. variablesOf: aClass
  1545.  
  1546. "Answer the variables defined by the aNonMetaClass.  Answer the instance variables if I'm not in meta mode, the class variables otherwise."
  1547.  
  1548.     | theNonMetaClass |
  1549.     aClass isMeta
  1550.         ifTrue: [theNonMetaClass := aClass soleInstance]
  1551.         ifFalse: [theNonMetaClass := aClass].
  1552.     (self meta)
  1553.         ifTrue: [^theNonMetaClass classVarNames]
  1554.         ifFalse: [^theNonMetaClass instVarNames]! !
  1555. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1556.  
  1557. ClassBrowser class
  1558.     instanceVariableNames: ''!
  1559.  
  1560.  
  1561. !ClassBrowser class methodsFor: 'instance creation'!
  1562.  
  1563. newOnClass: aClass
  1564.  
  1565.     "Schedule a new instance of the reciever to browse aClass."
  1566.  
  1567.     self newOnClass: aClass selector: nil!
  1568.  
  1569. newOnClass: aClass selector: aSelector
  1570.  
  1571.     "Schedule a new instance of the reciever to browse aClass initially showing aSelector (or nil)"
  1572.  
  1573.     (self new onClass: aClass selector: aSelector) open! !
  1574.  
  1575. !ClassBrowser class methodsFor: 'class initialization'!
  1576.  
  1577. install
  1578.  
  1579. "Install methods in Browser to have ClassBrowser and SystemOrganizerBrowser replace the normal Browsers."
  1580.  
  1581.     SystemOrganizerBrowser doInstall.
  1582.     self doInstall!
  1583.  
  1584. unInstall
  1585.  
  1586. "Uninstall the methods in Browser to have ClassBrowser and SystemOrganizerBrowser replace the normal Browsers."
  1587.  
  1588.     SystemOrganizerBrowser doUninstall.
  1589.     self doUninstall! !
  1590.  
  1591. !ClassBrowser class methodsFor: 'private'!
  1592.  
  1593. doInstall
  1594.  
  1595. "Install a method in Browser to have ClassBrowser replace the normal class browser."
  1596.  
  1597.     Browser class
  1598.         compile: 'newOnClass: aClass
  1599.  
  1600. "Create and schedule a view that is a browser for the class aClass."
  1601. "Be paranoid about ClassBrowser existing."
  1602.  
  1603.     (ClassBrowser respondsTo: #newOnClass:)
  1604.         ifTrue: [ClassBrowser newOnClass: aClass]
  1605.         ifFalse: [self openClassBrowserOn: (self new onClass: aClass)]'
  1606.         classified: 'instance creation'!
  1607.  
  1608. doUninstall
  1609.  
  1610. "Uninstall the method in Browser to have ClassBrowser replace the normal class browser."
  1611.  
  1612.     Browser class
  1613.         compile: 'newOnClass: aClass
  1614.     "Create and schedule a view that is a browser for the class aClass."
  1615.  
  1616.     self openClassBrowserOn: (self new onClass: aClass)'
  1617.         classified: 'instance creation'! !
  1618.  
  1619. !ClassBrowser class methodsFor: 'menu construction'!
  1620.  
  1621. labelsForSelectorPredicates: selectorPredicates objectOfVerbs: objectOfVerbs
  1622.  
  1623.     "Answer a collection of labels appropriate for the given collection of selectorPredicates (menu selectors that are predicate phrases) and with objectOfVerbs implied in the labels. If objectOfVerbs is nil then the labels will be generated without a objectOfVerbs."
  1624.     "The objectOfVerbs will be replaced by 'it' in the labels."
  1625.     "This functionality should all be implemented in PopUpMenu or something like that."
  1626.  
  1627.     | labels selectorToLabel |
  1628.  
  1629.     "Put spaces between each word in the selector."
  1630.     selectorToLabel := [:eachSelector | | label |
  1631.         label := WriteStream on: (String new: eachSelector size + 10).
  1632.         eachSelector do: [:eachCharacter |
  1633.             eachCharacter isUppercase
  1634.                 ifTrue: [label space; nextPut: eachCharacter asLowercase]
  1635.                 ifFalse: [label nextPut: eachCharacter].
  1636.             eachCharacter == $: ifTrue: [label space]].
  1637.         label contents].
  1638.     labels := selectorPredicates collect: selectorToLabel.
  1639.     "Replace the object of the verb with the abstract noun 'it' in the label."
  1640.     objectOfVerbs notNil ifTrue: [ | objectOfVerbsInLabel |
  1641.         objectOfVerbsInLabel := ' ', (selectorToLabel value: objectOfVerbs).
  1642.         labels := labels collect: [:eachLabel |
  1643.             eachLabel copyReplaceAll: objectOfVerbsInLabel with: ' it']].
  1644.     ^labels!
  1645.  
  1646. menuForSelectorPredicates: selectorPredicates
  1647.  
  1648.     "Answer a menu appropriate for the given collection of selectorPredicates (selectors which are predicate phrases)"
  1649.     "This behavior should exist in PopUpMenu.  And PopUpMenu should be generalized since a menu is a more general concept than a PopUpMenu."
  1650.  
  1651.     ^self menuForSelectorPredicates: selectorPredicates objectOfVerbs: nil!
  1652.  
  1653. menuForSelectorPredicates: selectorPredicates objectOfVerbs: objectOfVerbs
  1654.  
  1655.     "Answer a menu appropriate for the given collection of message selectors and with objectOfVerbs (a String) implied in the menu labels. If objectOfVerbs is nil then the labels will be generated without a objectOfVerbs."
  1656.     "The objectOfVerbs will be replaced by 'it' in the labels."
  1657.     "This behavior should exist in PopUpMenu.  And PopUpMenu should be generalized since a menu is a more general concept than a PopUpMenu."
  1658.  
  1659.     | labels lines |
  1660.  
  1661.     "Convert all the selector predicates into readable predicate phrases."
  1662.     labels := self labelsForSelectorPredicates: selectorPredicates objectOfVerbs: objectOfVerbs.
  1663.     "Figure out good places to put menu separating lines."
  1664.     lines := self menuLinesForPredicatePhrases: labels.
  1665.     "And answer the PopUpMenu."
  1666.     ^PopUpMenu labelArray: labels lines: lines values: selectorPredicates!
  1667.  
  1668. menuLinesForPredicatePhrases: predicatePhrases
  1669.  
  1670.     "Answer a collection of integers representing suggested menu line break points for the given collection of predicate phrases."
  1671.     "Calculate line breaks between groups of predicate phrases with different verbs (assumed to be first word in predicate phrase) and/or between groups of predicate phrases with different objects of the predicate verb (assumed to be the last word in the predicate phrase).  Obviously this isn't optimal but quite workable."
  1672.  
  1673.     | lines foundSection commonPredicateInSection commonObjectOfVerbInSection lastPredicate lastObjectOfVerb |
  1674.  
  1675.     lines := OrderedCollection new: predicatePhrases size.
  1676.     lastPredicate := lastObjectOfVerb := commonPredicateInSection := commonObjectOfVerbInSection := nil.
  1677.     foundSection := false.
  1678.     1 to: predicatePhrases size do: [:index | | thisLabel verb objectOfVerb |
  1679.         thisLabel := predicatePhrases at: index.
  1680.         verb := thisLabel copyUpTo: Character space.
  1681.         objectOfVerb := thisLabel
  1682.             copyFrom: (thisLabel lastIndexOf: Character space ifAbsent: [thisLabel size]) + 1
  1683.             to: thisLabel size.
  1684.         foundSection
  1685.             ifTrue: [
  1686.                 (commonPredicateInSection notNil and: [commonPredicateInSection ~= verb])
  1687.                     ifTrue: [foundSection := false].
  1688.                 (commonObjectOfVerbInSection notNil and: [commonObjectOfVerbInSection ~= objectOfVerb])
  1689.                     ifTrue: [foundSection := false].
  1690.                 foundSection ifFalse: [
  1691.                     lines addLast: index - 1.
  1692.                     commonPredicateInSection := commonObjectOfVerbInSection := nil]]
  1693.             ifFalse: [
  1694.                 lastPredicate = verb ifTrue: [
  1695.                     foundSection := true.
  1696.                     commonPredicateInSection := verb].
  1697.                 lastObjectOfVerb = objectOfVerb ifTrue: [
  1698.                     foundSection := true.
  1699.                     commonObjectOfVerbInSection := objectOfVerb].
  1700.                 foundSection ifTrue: [
  1701.                     (index - 2 > 0 and: [lines isEmpty or: [lines last ~= (index - 2)]])
  1702.                         ifTrue: [lines addLast: index - 2]]].
  1703.         lastPredicate := verb.
  1704.         lastObjectOfVerb := objectOfVerb].
  1705.     "If there were no lines and there are 5 or less labels, then put lines between all of them."
  1706.     (lines isEmpty and: [predicatePhrases size <= 5]) ifTrue: [
  1707.         lines := 1 to: predicatePhrases size - 1].
  1708.     ^lines! !
  1709.